home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip_2000-11_cd2.bin / sharewar / Slunec / app / 17 / _SETUP.1 / Najit projekt obsahujici dokument.pw < prev    next >
Text File  |  2000-08-27  |  5KB  |  147 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {     Programmer's Wizard 2 Pascal Script               }
  5. {     Petr Esner, petr.esner@atlas.cz                   }
  6. {                                                       }
  7. {     NAJIT PROJEKT OBSAHUJICI DOKUMENT.PW              }
  8. {     (popis jazyka v souboru SCRIPT.DOC)               }
  9. {                                                       }
  10. {*******************************************************}
  11. uses ScriptUtils;
  12.  
  13. function GetVerStr: string;
  14. var
  15.   mMajor, mMinor, mRel: Integer;
  16. Begin
  17.   GetVersionEx(mMajor, mMinor, mRel);
  18.   result := 'v' + IntToStr(mMajor) + '.' + IntToStr(mMinor) + '.' +
  19.     IntToStr(mRel);
  20. end;
  21.  
  22. function GetValidVerStr: string;
  23. Begin
  24.   result := 'v2.0.1'; //pozadovana verze PW
  25. end;
  26.  
  27. //globalni promenne
  28. var
  29.   gFileList, gProjList: Array of string;
  30.   gProjIDList, gWrkIDList: Array of Integer;
  31.   gArrayLength: Integer; //udrzuje nam aktualni delku seznamu nalezenych polozek
  32.  
  33. procedure AddFile(aProjName: string; aProjID, aWrkID: Integer; aFileName: string);
  34. Begin
  35.   //udelame si trochu mista na nohy
  36.   inc(gArrayLength);
  37.   SetArrayLength(gFileList, gArrayLength);
  38.   SetArrayLength(gProjList, gArrayLength);
  39.   SetArrayLength(gProjIDList, gArrayLength);
  40.   SetArrayLength(gWrkIDList, gArrayLength);
  41.  
  42.   //pridat nalezenou polozku do seznamu
  43.   gFileList[gArrayLength - 1] := aFileName;
  44.   gProjList[gArrayLength - 1] := aProjName;
  45.   gProjIDList[gArrayLength - 1] := aProjID;
  46.   gWrkIDList[gArrayLength - 1] := aWrkID;
  47. end;
  48.  
  49. procedure RunDialog;
  50. var
  51.   mAnswer: Integer;
  52.   mList: Array of string;
  53.   mIndex: Integer;
  54. Begin
  55.   //vytvorime pouzitelny seznam nalezenych polozek
  56.   SetArrayLength(mList, gArrayLength);
  57.   for mIndex := 0 to gArrayLength - 1 do
  58.     mList[mIndex] := '[' + gProjList[mIndex] + '] ' +
  59.       ExtractFileName(gFileList[mIndex]);
  60.  
  61.   //zobrazime seznam
  62.   mAnswer := ShowListDialog( 'V²sledky', 'Vyberte dokument:', mList);
  63.   if mAnswer <> -1 then Begin //neco vybral(a)
  64.     if OpenProject(gProjIDList[mAnswer]) then
  65.       if OpenWorkspace(gWrkIDList[mAnswer]) then
  66.         OpenFile(gFileList[mAnswer]);
  67.   end;
  68. end;
  69.  
  70. //procedure Main;
  71. var
  72.   mSearchFor: string; //hledany retezec
  73.   mProjIndex, mWrkIndex, mFileIndex: Integer;
  74.   mFileCount: Integer;
  75.   mWrkName, mWrkDescription: string;
  76.   mProjFileName, mProjName, mProjDescription: string;
  77.   mFile: string;
  78. Begin
  79.   if GetValidVerStr <> GetVerStr then //nespravna verze?
  80.     ShowMessage('Upozorn∞nφ: tento skript byl napsßn pro Programmers Wizard ' +
  81.       GetValidVerStr + '. Momentßln∞ spuÜt∞nß verze: ' + GetVerStr);
  82.  
  83.   REPEAT
  84.     //zeptat se na nazev hledaneho dokumentu
  85.     if not (InputQuery('Najφt projekt obsahujφcφ dokument...',
  86.       '╚ßst nßzvu hledanΘho dokumentu:', mSearchFor)) then Halt;
  87.  
  88.     //nazev nesmi byt prazdny retezec
  89.     if mSearchFor = '' then
  90.       ShowMessage('Nelze hledat prßzdn² °et∞zec.');
  91.   until mSearchFor <> ''; //a tak porad dokola, dokud jim to nedojde :-)
  92.  
  93.   //nebudeme si trvat na case-sensitivnim hledani, ze ne.
  94.   mSearchFor := LowerCase(mSearchFor);
  95.  
  96.   //prohledat vsechny plochy ve vsech projektech na pritomnost hledaneho souboru
  97.  
  98.   //vsechny projekty
  99.   for mProjIndex := 0 to GetProjectCount - 1 do Begin
  100.     //zjistime jmeno prohledavaneho projektu...
  101.     GetProjectInfo(
  102.       mProjIndex,
  103.       mProjFileName,
  104.       mProjName,
  105.       mProjDescription
  106.     );
  107.     //...a zobrazime prubeh operace na stavovem radku
  108.     SetStatusBarMessage('Prohledßvß se...' + mProjName);
  109.  
  110.     //vsechny plochy
  111.     for mWrkIndex := 0 to GetWorkspaceCountEx(mProjIndex) - 1 do Begin
  112.       //potrebujeme zjistit pocet souboru na plose
  113.       if GetWorkspaceInfoEx(
  114.            mProjIndex,
  115.            mWrkIndex,
  116.            mWrkName,
  117.            mWrkDescription,
  118.            mFileCount
  119.          ) then
  120.         //vsechny dokumenty
  121.         for mFileIndex := 0 to mFileCount - 1 do Begin
  122.           mFile := GetWorkspaceFileEx(mProjIndex, mWrkIndex, mFileIndex);
  123.           //bingo?
  124.           if Pos(mSearchFor, LowerCase(mFile)) > 0 then
  125.             AddFile(mProjName, mProjIndex, mWrkIndex, mFile); //pridat soubor do
  126.               //naseho seznamu
  127.         end;
  128.     end; //for mWrkIndex ...
  129.   end; //for mProjIndex ...
  130.  
  131.   //zrusit text na stavovem radku
  132.   CancelStatusBarMessage;
  133.  
  134.   if gArrayLength = 0 then //zadna shoda?
  135.     ShowMessage('Nebyla nalezena ₧ßdnß shoda.')
  136.     else if gArrayLength = 1 then //prave jedna shoda?
  137.       Begin
  138.         if OpenProject(gProjIDList[0]) then
  139.           if OpenWorkspace(gWrkIDList[0]) then
  140.             OpenFile(gFileList[0]);
  141.       end else //vice shod, to chce seznam
  142.         RunDialog;
  143.  
  144.   //no a to staci, no.
  145. end.
  146.  
  147.